Unit
	PONCompiler;

Interface

 {
  EBNF:
  
 Input file syntax:
  instancename ::= <identifier>
  classname ::= <identifier>
  propertyname ::= <identifier>
  property ::= <identifier> '=' <string>
  propertylist ::= <property> [ ';' <property> [...] ]
		class ::= 'class' <instancename> 'of' <classname> [ '(' [ <propertylist> ] ')' ] [ 'begin' [ <classlist> ] 'end' ]
  classlist ::= <class> [ ';' <class> [...] ]
  classfile :: = <classlist> '.'
 }

Uses
	Classes,
	SysUtils,
	StrUtils,
	Source,
	Scanner,
	TokenIterator,
	SyntaxTree,
	Parser;

Type
	ECompiler = Exception;

	TInstance = Record
		ClassName,
		InstanceName : String;
	End;
	TArrayOfInstance = Array Of TInstance;
	
	TOwnership = Record
		InstanceName,
		OwnerName : String;
	End;
	TArrayOfOwnership = Array Of TOwnership;
	
	TProperty = Record
		InstanceName,
		PropertyName,
		Value : String;
	End;
	TArrayOfProperty = Array Of TProperty;

	TArrayOfClassInstances = Array Of TClassSyntax;
	TCollectClassInstances = Class(TSyntaxTreeDownwardIterator)
	Private
		fInstances : TArrayOfClassInstances;
	Public
		Function Process(Const aTarget : TSyntaxTreeElement): Boolean; Override;
		Function CompileInstances: TArrayOfInstance;
		Function CompileOwnerships: TArrayOfOwnership;
	End;
	
	TArrayOfClassProperties = Array Of TPropertySyntax;
	TCollectProperties = Class(TSyntaxTreeDownwardIterator)
	Private
		fProperties : TArrayOfClassProperties;
	Public
		Function Process(Const aTarget : TSyntaxTreeElement): Boolean; Override;
		Function CompileProperties: TArrayOfProperty;
	End;
	
	TPONCompiler = Class
	Private
		fInstances : TArrayOfInstance;
		fOwnership : TArrayOfOwnership;
		fProperties : TArrayOfProperty;
		fDefines : TStringList;
		fSource : TStream;
		fSourceRoot : TSyntaxTreeElement;
		fTokenIterator : TTokenIterator;
		fTokens : TTokenList;
		fFileName : String;
		Function SourceFileCallBack(SrcName : String): TStream;
	Public
		Constructor Create(Const aSource : String);
		Destructor Destroy; Override;
		Procedure Compile;
		Property Defines: TStringList Read fDefines;
		Property Instances: TArrayOfInstance Read fInstances;
		Property Ownership: TArrayOfOwnership Read fOwnership;
		Property Properties: TArrayOfProperty Read fProperties;
	End;
	
Implementation

Function TCollectClassInstances.Process(Const aTarget : TSyntaxTreeElement): Boolean;
Begin
	If aTarget Is TClassSyntax Then
	Begin
		SetLength(fInstances, Length(fInstances) + 1);
		fInstances[High(fInstances)] := aTarget As TClassSyntax;
	End;
	Result := True;
End;

Function TCollectClassInstances.CompileInstances: TArrayOfInstance;
Var
	lCtrl : Integer;
Begin
	SetLength(Result, 0);
	For lCtrl := Low(fInstances) To High(fInstances) Do
		With fInstances[lCtrl] Do
		Begin
			SetLength(Result, Length(Result) + 1);
			Result[High(Result)].ClassName := ClassKind.Token.Value;
			Result[High(Result)].InstanceName := InstanceName.Token.Value;
		End;
End;

Function TCollectClassInstances.CompileOwnerships: TArrayOfOwnership;
Var
	lCtrl : Integer;
	lOwner : TClassSyntax;
Begin
	SetLength(Result, 0);
	For lCtrl := Low(fInstances) To High(fInstances) Do
	Begin
		SetLength(Result, Length(Result) + 1);
		If Assigned(fInstances[lCtrl].Owner) And (fInstances[lCtrl].Owner Is TClassSyntax) Then
			lOwner := fInstances[lCtrl].Owner As TClassSyntax
		Else
			lOwner := Nil;
		If Assigned(lOwner) Then
		Begin
			Result[High(Result)].InstanceName := fInstances[lCtrl].InstanceName.Token.Value;
			Result[High(Result)].OwnerName := lOwner.InstanceName.Token.Value;
		End
		Else
		Begin
			Result[High(Result)].InstanceName := fInstances[lCtrl].InstanceName.Token.Value;
			Result[High(Result)].OwnerName := '';
		End
	End;
End;

Function TCollectProperties.Process(Const aTarget : TSyntaxTreeElement): Boolean;
Begin
	If aTarget Is TPropertySyntax Then
	Begin
		SetLength(fProperties, Length(fProperties) + 1);
		fProperties[High(fProperties)] := aTarget As TPropertySyntax;
	End;
	Result := True;
End;

Function TCollectProperties.CompileProperties: TArrayOfProperty;
Var
	lCtrl : Integer;
	lOwner : TClassSyntax;
Begin
	SetLength(Result, 0);
	For lCtrl := Low(fProperties) To High(fProperties) Do
	Begin
		// Debug WriteLn(fProperties[lCtrl].Identifier.Token.Value, ', ', fProperties[lCtrl].Value.Token.Value);
		SetLength(Result, Length(Result) + 1);
		If Assigned(fProperties[lCtrl].Owner) And (fProperties[lCtrl].Owner Is TClassSyntax) Then
			lOwner := fProperties[lCtrl].Owner As TClassSyntax
		Else
			Raise ECompiler.Create('Owner of a property is not a TClassSyntax (?).');
		Result[High(Result)].InstanceName := lOwner.InstanceName.Token.Value;
		Result[High(Result)].PropertyName := fProperties[lCtrl].Identifier.Token.Value;
		Result[High(Result)].Value := fProperties[lCtrl].Value.Token.Value;
	End;
End;

Function TPONCompiler.SourceFileCallBack(SrcName : String): TStream;
Begin
	Result := TFileStream.Create(SrcName, fmOpenRead);
End;

Constructor TPONCompiler.Create(Const aSource : String);
Begin
	Inherited Create;
	fSource := SourceFileCallBack(aSource);
	fDefines := TStringList.Create;
	fFileName := aSource;
End;

Destructor TPONCompiler.Destroy;
Begin
	fDefines.Free;
	fSource.Free;
	Inherited Destroy;
End;

Procedure TPONCompiler.Compile;
Var
	lClassInstances : TCollectClassInstances;
	lProperties : TCollectProperties;
Begin
	// Debug  WriteLn('Scanner phase.');
	fTokens := Scanner.Scanner(fFileName, fSource);
	// Debug  WriteLn('Pre-processor phase.');
	fTokens := PreProcess(fFileName, fTokens, fDefines, SourceFileCallBack);
	fTokenIterator := TTokenIterator.Create(fTokens);
	// Debug  WriteLn('Parser phase.');
	fSourceRoot := Parser.Parser(fTokenIterator);
	// Debug  WriteLn('Freeing scanner resources.');
	fTokenIterator.Free;
	// Debug  WriteLn('Syntax tree phase:');
	lClassInstances := TCollectClassInstances.Create;
	// Debug  WriteLn('Collecting class instances.');
	lClassInstances.Visit(fSourceRoot);
	lProperties := TCollectProperties.Create;
	// Debug  WriteLn('Collecting properties.');
	lProperties.Visit(fSourceRoot);
	// Debug  WriteLn('Generating instance list.');
	fInstances := lClassInstances.CompileInstances;
	// Debug  WriteLn('Generating ownership relation list.');
	fOwnership := lClassInstances.CompileOwnerships;
	// Debug  WriteLn('Generating property list.');
	fProperties := lProperties.CompileProperties;
	lClassInstances.Free;
	lProperties.Free;
End;

End.